home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / Demo folder / Turtle < prev    next >
Text File  |  1997-10-28  |  4KB  |  143 lines
  1. \  Turtle Graphics Objects for Demo
  2.  
  3. need    sin
  4.  
  5. decimal
  6.  
  7. \ Class PEN defines a turtle-graphics pen.
  8.  
  9. syscall GetPenState
  10. syscall SetPenState
  11. syscall Line
  12. syscall LineTo
  13.  
  14. :class    PEN    super{ object }
  15.  
  16. 68k_record{            \ These first 5 ivars comprise a PenState structure
  17.     point    PnLoc            \ location of pen
  18.     point    PnSize            \ width,  height
  19.     int        PnMode
  20.     var        PnPatLo
  21.     var        PnPatHi
  22. }
  23.     angle    Direction
  24.     point    homeLoc 
  25.     int        maxReps
  26.     int        initLen
  27.     int        deltaLen            \ change in len
  28.     int        deltaDeg            \ change in angle
  29.  
  30.  
  31. :m GET:    ^base  GetPenState   ;m        \ Save state here
  32. :m SET:    ^base  SetPenState   ;m        \ Restore from here
  33.  
  34. :m TURN:  ( deg -- )    +: direction   ;m
  35.  
  36. :m UP:        90 put: direction   ;m
  37.  
  38. :m MOVETO:    \ ( x y -- )    Draws a line to x,y if pen shows
  39.     set: self  LineTo  get: self  ;m
  40.  
  41. :m MOVE:  { dist  -- }    \ Draws dist bits in current direction
  42.     set: self  cos: direction  dist * 10000 /
  43.     sin: direction  dist * 10000 /   negate
  44.     Line  get: self  ;m
  45.        
  46. :m GOTO:    \ ( x y -- )    Goes to a location without drawing
  47.     put:  PnLoc   ;m
  48.    
  49. :m CENTER:    \ ( x y -- )    Sets the center coordinates
  50.     put: homeLoc   ;m
  51.    
  52. :m HOME:    \ ( -- )        Places pen in center of Mops window
  53.     get: homeLoc  goto: self   ;m
  54.  
  55. :m SIZE:        \ ( w h -- )    Sets size in pixels of drawing pen
  56.     put: PnSize   ;m
  57.  
  58. :m INIT:        \ ( x y w h mode  -- )
  59.     put: PnMode  put: PnSize   put: PnLoc   ;m
  60.  
  61. :m PUTRANGE:        \ ( initlen dLen dDeg -- )      Sets parameters
  62.     put: deltaDeg  put: deltaLen  put: initLen   ;m
  63.  
  64. :m PUTMAX:   ( maxReps -- )    put: maxReps  ;m
  65.  
  66. :m CLASSINIT:   get: self   200 put: maxReps  ;m
  67.  
  68. :m SPIRAL:  { \ dist  degrees delta  reps -- }
  69.             \ Draws a spiral of line segments - Logo POLYSPI
  70.     home: self
  71.     get: initLen  -> dist  get: deltaLen  -> delta
  72.     get: deltaDeg  -> degrees   0 -> reps
  73.     begin    1 ++> reps  reps  get: maxReps  < 
  74.     while    dist  move: self   degrees  turn: self
  75.         delta ++> dist  
  76.     repeat   ;m
  77.  
  78. :m DRAGON:    \ ( n -- )    Dragon curves from Martin Gardner
  79.     dup
  80.     NIF    get: deltaLen  move: self  drop  
  81.     ELSE    dup  0> 
  82.         IF    dup  1-  dragon: self  
  83.             get: deltadeg  turn: self
  84.             1 swap -   dragon: self 
  85.         ELSE
  86.             -1 over -   dragon: self
  87.             360 get: deltadeg  -  turn: self
  88.             1+  dragon: self 
  89.         THEN
  90.     THEN   ;m
  91.         
  92. :m LJ:  { \ reps -- }    \ Draws an infinite Lissajous figure 
  93.     up: self   0 -> reps
  94.     get: initLen   get: direction  *  cos    120 /          getX: homeLoc  +
  95.     get: deltalen  get: direction  *  sin   120 /  negate  getY: homeLoc  +
  96.     goto: self 
  97.     begin   1 ++> reps  reps  get: maxReps  <
  98.     WHILE
  99.         get: initLen    get: direction  *  cos 120 /  getX: homeLoc +
  100.         get: deltaLen get: direction  *  sin  120 /  negate
  101.         getY: homeLoc + moveTo: self
  102.         get: deltaDeg turn: self
  103.     REPEAT   ;m
  104. ;class
  105.  
  106. \ Define a Smalltalk Polygon object as subclass of Pen 
  107.  
  108. :class  POLY    super{  pen  }
  109.  
  110.     int    Sides        \ # of sides in the Polygon  
  111.     int    Length        \ Length of each side  
  112.  
  113. :m DRAW:  { \ turnAngle -- }
  114.     360  get: sides  /   -> turnAngle
  115.     get: sides  0
  116.     DO    get:  length  move: self  
  117.         turnAngle  turn: self
  118.     LOOP  ;m
  119.  
  120. :m SIZE:        \ ( len  #sides -- )    Stores sides and goes to Home
  121.     get: self  put: sides  put: length 
  122.     home:  self   up: self   ;m
  123.  
  124. :m SPIN:  { \ reps -- }        \ Spins a series of polygons around a point  
  125.     home: self  10 get: initLen  size: self
  126.     0 -> reps 
  127.     BEGIN    reps  get: maxReps  < 
  128.     WHILE    draw: self  get: deltaDeg  turn: self
  129.         get: deltaLen  +: length  1 ++> reps
  130.     REPEAT   ;m
  131.      
  132. :m CLASSINIT:        \ Default Poly is 30-dot triangle
  133.     30 3 size: self  100 put: maxReps   ;m
  134.  
  135. ;class
  136.  
  137. \ Create a pen named Bic
  138. Pen    BIC
  139.  
  140. \ Create a Polygon named Anna
  141. Poly ANNA
  142. 60 4  Size: Anna
  143.